home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tpmulti.zip
/
QUEUE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
11KB
|
276 lines
{//////////////////////////////////////////////////////////////////////////////
/// ///
/// Universelle Verwaltung doppelt verketteter Listen ///
/// ///
/// (c) Christian Philipps, Moers ///
/// im November 1988 ///
/// ///
/// Dieses System erfordert Turbo-Pascal V5.0 ///
/// und die Unit CpMulti ///
/// ///
/// Wann immer ein Element entfernt werden soll, das sich am Kopf bzw. ///
/// Ende der Queue befindet, ist der Aufwand für die Löschung konstant. ///
/// Die durchschnittliche Löschzeit bei Elementen aus der Mitte der Queue, ///
/// wächst proportional zur Anzahl der Elemente in der Kette. ///
/// ///
//////////////////////////////////////////////////////////////////////////////}
{$R-,S-,I-,D-,F-,V-,B-,N-,L-,O-}
UNIT Queue;
INTERFACE
USES CpMulti, CpMisc;
TYPE QueuePtrType = ^QueueRecType;
QueueRecType = RECORD {Queue-Element}
Data : Pointer; {Zeiger auf Datenbereich}
Next : QueuePtrType; {Zeiger auf nächstes Element}
Prev : QueuePtrType; {Zeiger auf Vorgänger}
END;
QueDataType = LongInt;
QueueType = RECORD {Anker der Queue}
Critical : Pointer; {Semaphore für Update-Zugriff}
Elements : Pointer; {Element-Count}
QueData : QueDataType; {User-Defined Data}
First : QueuePtrType; {Zeiger auf Queue-Anfang}
Last : QueuePtrType; {Zeiger auf Queue-Ende}
END;
VergFuncType = FUNCTION(Vergleichswert, Data:Pointer):BOOLEAN;
PROCEDURE AppendRec(VAR QueueRec:QueueType; Data:Pointer);
FUNCTION RemoveRec(VAR QueueRec:QueueType; Data:Pointer):Pointer;
PROCEDURE CreQueue(VAR Q:QueueType);
FUNCTION DeleteQueue(VAR Q:QueueType):BOOLEAN;
FUNCTION FindRec(VAR QueueRec:QueueType; Vergleichswert:Pointer;
ElemFound:VergFuncType):Pointer;
{-----------------------------------------------------------------------------}
IMPLEMENTATION
TYPE QueueErrType = (QueCreSem, QueRemSem, QueHeap);
VAR SearchQueue : Pointer;
{-----------------------------------------------------------------------------}
PROCEDURE QueueErr(ErrNo:QueueErrType);
BEGIN {QueueErr}
Write(^G'Queue: ');
CASE ErrNo OF
QueHeap: Writeln('Zuwenig dynamischer Speicher vorhanden!');
QueCreSem: Writeln('Fehler beim Anlegen einer Semaphore!');
QueRemSem: Writeln('Fehler beim Löschen einer Semaphore!');
ELSE Writeln('Unbekannter Fehler: ',Byte(ErrNo));
END;
Halt(1);
END; {QueueErr}
{-----------------------------------------------------------------------------}
PROCEDURE AppendRec(VAR QueueRec:QueueType; Data:Pointer);
{ Anhängen eines Elementes an die durch QueueRec verwaltete Queue.
Für das Element wird ein Verwaltungssatz angelegt. Fehlt der hierfür er-
forderliche dynamische Speicher, so wird die Aktion abgebochen!
Zum Abschluß der Aktion wird der Element-Count der Queue erhöht!
}
VAR Elem : QueuePtrType;
BEGIN {AppendRec}
IF MaxAvail < SizeOf(QueueRecType)
THEN QueueErr(QueHeap);
SafeGetMem(Elem,SizeOf(Elem^)); {erzeuge Verwaltungssatz}
Elem^.Next := NIL; {Bildet das Kettenende}
Elem^.Data := Data; {hänge Datenbereich ein}
WITH QueueRec DO
BEGIN
SemWait(Critical); {Kritischer Bereich}
IF First = NIL {erstes Kettenelement}
THEN First := Elem
ELSE BEGIN
Last^.Next := Elem; {Verketten}
END;
Elem^.Prev := Last; {Vorgänger merken}
Last := Elem; {neues Kettenende merken}
SemSignal(Critical); {Freigeben der Queue}
SemSignal(Elements); {Erhöhe Anzahl Elemente}
END;
END; {AppendRec}
{-----------------------------------------------------------------------------}
FUNCTION RemoveRec(VAR QueueRec:QueueType; Data:Pointer):Pointer;
{
Entfernen des Queue-Elementes auf dessen Datenbereich der Zeiger Data
verweist. Dieser Zeiger MUSS auf ein gültiges Kettenelement verweisen, da
zur Verbesserung der Performance von dieser Voraussetzung ausgegangen wird.
Fehlerhafte Datenbereichszeiger werden mit einiger Sicherheit im Nirwana
enden; günstigsten Falles jedoch mit einer ungültige Pointeroperation.
Der Verwaltungssatz zu diesem Element wird freigegeben.
ACHTUNG!!! Der Element-Count wird NICHT verändert, da in der Regel auf die
Warteschlange über ein SemWait(Elements) zugegriffen wird, wenn die Entnahme
von Daten beabsichtigt ist. Durch diesen Aufruf wurde der Element-Count be-
reits vor Aufruf von RemoveRec erniedrigt.
}
LABEL ExitRemove;
VAR Elem : QueuePtrType;
BEGIN {RemoveRec}
RemoveRec := Data; { Zeiger auf Elem zurückliefern }
WITH QueueRec DO
BEGIN
SemWait(Critical); { Exclusiver Zugriff erforderlich}
Elem := First; { für 2 Fälle zutreffend }
IF First = Last { nur 1 Kettenelement }
THEN BEGIN
First := NIL;
Last := NIL;
Goto ExitRemove;
END;
IF First^.Data = Data { erstes Element! }
THEN BEGIN
First := First^.Next;
First^.Prev := NIL;
Goto ExitRemove;
END;
IF Last^.Data = Data { letztes Element }
THEN BEGIN
Elem := Last; { für FreeMem }
Last^.Prev^.Next := NIL; { Vorwärtskette abschließen }
Last := Last^.Prev; { Last aktualisieren }
Goto ExitRemove;
END;
Elem := First; { suche den Verwaltungssatz }
WHILE Elem^.Data <> Data DO
Elem := Elem^.Next;
Elem^.Prev^.Next := Elem^.Next; { Vorwärtsverweis durchreichen }
Elem^.Next^.Prev := Elem^.Prev; { und rückverketten }
ExitRemove:
SafeFreeMem(Elem,SizeOf(Elem^)); { Freigeben Verwaltungssatz}
SemSignal(Critical); { Freigeben der Queue }
END;
END; {RemoveRec}
{-----------------------------------------------------------------------------}
PROCEDURE CreQueue(VAR Q:QueueType);
{ Anlegen und Initialisieren einer Queue }
BEGIN {CreQueue}
WITH Q DO
BEGIN
IF (CreateSem(Critical) <> Sem_Ok) OR
(CreateSem(Elements) <> Sem_Ok)
THEN QueueErr(QueCreSem);
SemClear(Elements);
First := NIL;
Last := NIL;
END;
END; {CreQueue}
{-----------------------------------------------------------------------------}
FUNCTION DeleteQueue(VAR Q:QueueType):BOOLEAN;
{
Löschen einer Queue, sofern diese derzeit keine Elemente enthält.
Aller durch die Semaphoren belegte Speicherplatz wird wieder freigegeben.
Ist die Warteschlange einer Semaphore nicht leer, oder enthält die Queue
noch Elemente, so zeigt der Funktionswert FALSE Mißerfolg an.
}
BEGIN {DeleteQueue}
DeleteQueue := False;
WITH Q DO
BEGIN
IF (First <> NIL) OR
SemSoWaiting(Critical) OR
SemSoWaiting(Elements)
THEN Exit;
IF (RemoveSem(Critical) <> Sem_OK) OR
(RemoveSem(Elements) <> Sem_OK)
THEN QueueErr(QueRemSem);
END;
DeleteQueue := True;
END; {DeleteQueue}
{-----------------------------------------------------------------------------}
FUNCTION FindRec(VAR QueueRec:QueueType; Vergleichswert:Pointer;
ElemFound:VergFuncType):Pointer;
{
Durchsuchen einer Queue nach einem bestimmten Element.
Der Parameter Data ist ein Zeiger auf ein irgendwie geartetes Datenelement,
das die durch Func angesprochene Funktion als Vergleichswert benötigt.
Func ist ein Zeiger auf eine Funktion, die als Parameter zwei Zeiger, einen
auf den Vergleichswert und einen auf den Datenbereich eines Queue-Elements
erhält. Der Funktionswert dieser Funktion zeigt an, ob das gesuchte Element
gefunden werden konnte. True = Gefunden. Diese Funktion muß eine FAR-Funk-
tion sein, also z. B. mit dem Compilerswitch F+ compiliert worden sein.
Kann in der gesamten Queue kein passendes Element gefunden werden, so lie-
fert FindRec NIL, anderenfalls einen Zeiger auf den Datenbereich des ge-
fundenen Kettenelementes.
Während der Suche wird die Queue blockiert, um gleichzeitige Updates auszu-
schließen. Ferner wird durch die Semaphore SearchQueue gewährleistet, daß
zu einem Zeitpunkt immer nur eine Suchanforderung aktiv sein kann. Dies ist
erforderlich, da jede Suchanforderung die globale Variable ProcAddr verän-
dert, die auf die Vergleichsfunktion verweist.
}
LABEL ExitFindRec;
VAR Elem : QueuePtrType;
BEGIN {FindRec}
SemWait(SearchQueue); {ProcAddr exclusiv anfordern}
FindRec := NIL;
WITH QueueRec DO
BEGIN
SemWait(Critical); {blockiere die Queue}
IF First = NIL
THEN Goto ExitFindRec {Queue leer}
ELSE Elem := First; {initialisiere Arbeitspointer}
WHILE (Elem <> NIL) DO
IF ElemFound(Vergleichswert,Elem^.Data)
THEN BEGIN {Eintrag gefunden}
FindRec := Elem^.Data;
Goto ExitFindRec;
END
ELSE Elem := Elem^.Next; {weiter mit Folgeelement}
ExitFindRec:
SemSignal(Critical);
SemSignal(SearchQueue);
END;
END; {FindRec}
{-----------------------------------------------------------------------------}
BEGIN {Initialisierung}
IF CreateSem(SearchQueue) <> Sem_OK
THEN QueueErr(QueCreSem);
END. {Initialisierung}
{//////////////////////////////////////////////////////////////////////////////
/// Ende des Moduls ///
//////////////////////////////////////////////////////////////////////////////}